home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / FILDINP.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-26  |  4KB  |  137 lines
  1. {The two procedures which are included are intended to allow you to place
  2.  the cursor on a field, specify the field's size, and obtain its input.
  3.  
  4.  This is written for MS-DOS and PC-DOS systems, but may also work in
  5.  CP/M environments.
  6.  
  7.  Variables to be declared are:
  8.     Field : String[n] Where n = maximum field size to be input;
  9.     Place,FieldSize : Integer;  (Place points to where you are in the field)
  10.     Result : Integer;           (Indicates error in numeric conversion)
  11.     Ch : Char;
  12.     Cursor : Char;        (an underscore (_) for example)
  13.  
  14.  Note that you can include error conditions in I/O checking by passing
  15.  the value of Result to your Error Trapping routines.
  16.  
  17.  You will need to set FieldSize prior to calling InputField, and you should
  18.  reset Field to '' after assigning it to your input variable.
  19.  
  20.  StripBlanks is used if you are getting Numeric input.
  21.  
  22.  These procedures should be handy if you are using formatted screen input,
  23.  such as invoice forms, time sheets, etc.
  24.  
  25.  written by Ken McClure
  26.  75156,2641
  27.  }
  28.  
  29.  
  30. Program Input;
  31.  
  32. var
  33.   Field         : String[10];
  34.   FieldSize     : Integer;
  35.   Ch            : Char;
  36.   TestFieldOne  : String[8];
  37.   TestFieldTwo  : Integer;
  38.   Result        : Integer;
  39.   Place         : Integer;
  40.   Cursor        : Char;
  41.  
  42. procedure InputField;
  43.  
  44. label Bypass;
  45.  
  46. begin
  47.     Field := '';
  48.     Place := 0;
  49.     Repeat
  50.       Read(Kbd,Ch);
  51.       If Length(Field)<=FieldSize then begin
  52.         Case Ch of
  53.           #8       : begin             {BackSpace key}
  54.                        If Place=0 then begin  {avoid backspacing beyond}
  55.                          Write(Trm,Chr(8));   {beginning of field      }
  56.                          Write(' ');
  57.                        end
  58.                        else begin
  59.                          Delete(Field,Place,1); {destructive backspace}
  60.                          Place := Place-1;
  61.                          Write(Trm,Chr(8));
  62.                          Write(Cursor);
  63.                          Write(Trm,Chr(8));
  64.                        end;
  65.                      end;
  66.            #127    : begin;             {Delete Key}
  67.                        If Place=0 then begin  {avoid backspacing beyond}
  68.                          Write(Trm,Chr(8));   {beginning of field again}
  69.                          Write(' ');
  70.                        end
  71.                        else begin
  72.                          Delete(Field,Place,1); {destructive backspace}
  73.                          Place := Place-1;
  74.                          Write(Trm,Chr(8));
  75.                          Write(Cursor);
  76.                          Write(Trm,Chr(8));
  77.                        end;
  78.                      end;
  79.            #13     : begin              {Carraige Return--End of input}
  80.                        GoTo Bypass;     {for this field               }
  81.                      end;
  82.         else
  83.           If Length(Field)<FieldSize then begin
  84.             Place := Place+1;
  85.             Write(Ch);
  86.             Field := Field + Ch;
  87.           end
  88.           else begin
  89.             If Ch <> Chr(13) then
  90.               Write(Chr(7));            {Ring bell at terminal if at end of}
  91.           end;                          {field and no RETURN key pressed   }
  92. ByPass:
  93.         end;
  94.       end;
  95.     Until Ch=Chr(13);
  96. end;
  97.  
  98. procedure StripBlanks;            {don't use on Alpha-numeric fields...}
  99.                                   {blanks there may be valid           }
  100. begin
  101.   Repeat
  102.     Place := Pos(' ',Field);
  103.     Delete(Field,Place,1);
  104.     Place := Pos(' ',Field);
  105.   Until Place=0;
  106. end;
  107.  
  108. begin                               {little sample program}
  109.   ClrScr;
  110.   Write('What do you use to delineate fields? (e.g., "_") :');
  111.   Read(Cursor);
  112.   GoToXY(30,4);
  113.   Write('Test Input');
  114.   GoToXY(10,6);
  115.   Write('Alpha Data: ');
  116.   GoToXY(30,6);
  117.   FieldSize := 8;
  118.   For Place := 1 to FieldSize do begin
  119.     Write(Cursor);
  120.   end;
  121.   GoToXY(30,6);
  122.   InputField;
  123.   TestFieldOne := Field;
  124.   Field := '';
  125.   GoToXY(10,8);
  126.   Write('Numeric Data: ');
  127.   GoToXY(30,8);
  128.   FieldSize := 4;
  129.   For Place := 1 to FieldSize do begin
  130.     Write(Cursor);
  131.   end;
  132.   GoToXY(30,8);
  133.   InputField;
  134.   StripBlanks;
  135.   Val(Field,TestFieldTwo,Result);
  136.   Field := '';
  137. end.